(library (grid-gen Harten2)

;; This is not really Harten entropy fix, but some experimental stuff

(export Harten2:chrs
        Harten2:set-eps!
)

(import (guile)
        (rnrs)
        (grid-gen main)
        (grid-gen math)
        (grid-gen vars)
        (except (srfi srfi-1) map)
)

(define eps (comp-float "eps" 0.25))

(define qa (lambda (a0 la0 ra0)
  (let* ((la `(min ,la0 ,ra0))
         (ra `(max ,la0 ,ra0))
         (a  `(if (<= ,la ,ra) ,a0 (* -1.0 ,a0)))
         (dl `(max 0.0 (- ,a ,la)))
         (dr `(max 0.0 (- ,ra ,a)))
         (delta `(max (abs ,la0) (abs ,ra0)))
        )
   ;`(if (<= (abs ,a) ,delta)  ;; Harten-Hyman
   ;     (abs ,delta)
   ;     (abs ,a)
   ; )
   `(max (abs ,a0) ,delta)
   
   ;`(if (and (>= ,a (* -1.0 ,dr) (<= ,a ,dl)))  ;; LeVeque (dont works?)
   ;     (/ (+ (* (- ,dl ,dr) ,a) (* 2.0 ,dl ,dr)) (+ ,dl ,dr))
   ;     (abs ,a)
   ; )
     
   ;`(if (<= (abs ,a0) ,delta)  ;; Harten-Hyman 2
   ;     (* 0.5 (+ (/ (** ,a0 2.0) ,delta) ,delta))
   ;     (abs ,a0)
   ; )
   ;`(max (abs ,a0) (* 0.5 (+ (/ (** ,a0 2.0) ,delta) ,delta)))
  )
))


(define Harten2:set-eps! (lambda (e) (set! eps e)))

(define hart (lambda (a la ra)
  ;(let (;;;(e `(abs (* 4.0 (max 0.0 (- ,a ,la) (- ,ra ,a)))))
  ;      (e eps)
  ;     )
  ;  `(max (abs ,a)
  ;        (/ (+ (** (min (abs ,a) ,e) 2) (** ,e 2)) (* 2.0 ,e))
  ;   )
  ;)
  (qa a la ra)
))

(define Harten2:chrs (lambda (chrs)
  (lambda (d)
    (lambda (vm)
      (apply math-cvector
        (let* ((cl (arr-elements ((chrs d) (vm 'vl))))
               (cr (arr-elements ((chrs d) (vm 'vr))))
               (cm (arr-elements ((chrs d) vm)))
              )
            ;(append `(,(hart (car cm) (car cl) (car cr)))
            ;         (reverse (cdr (reverse (cdr cm))))
            ;        `(,(hart (car (reverse cm))
            ;                 (car (reverse cl))
            ;                 (car (reverse cr))
            ;           )
            ;         )
            ;)
          (list
           `(max (abs ,(list-ref cm 0))
                 (abs ,(list-ref cl 0))
                 (abs ,(list-ref cr 0))
            )
            (list-ref cm 1)
            (list-ref cm 2)
            (list-ref cm 3)
           `(max (abs ,(list-ref cm 4))
                 (abs ,(list-ref cl 4))
                 (abs ,(list-ref cr 4))
            )
          )
        )
      )
    )
  )
))

)

(import (grid-gen main))
(set! PHYS:chrs (Harten2:chrs PHYS:chrs))
